perm filename HIA.SAI[1,BGB] blob
sn#001258 filedate 1972-10-22 generic text, type T, neo UTF8
00100 BEGIN "HIA"
00200 REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00300 REQUIRE "TRIGER[SYS,BGB]" SOURCE_FILE;
00400 REQUIRE "DD[DD,BGB]" SOURCE_FILE;
00500 REQUIRE "COMMON[IA,BGB]" SOURCE_FILE;
00600 α LEAPING LIZARDS;
00700 REQUIRE 100 NEW_ITEMS;
00800 REQUIRE 100 PNAMES;
00900 α TELETYPE COMMAND STATE;
01000 INTEGER CHR,CTRL,META,LETT,MCBITS;
01100 α SOURCE AND OBJECT WINDOWS;
01200 DEFINE
01300 SX. = "DATUM(SWINDO)[1]",
01400 SY. = "DATUM(SWINDO)[2]",
01500 DX. = "DATUM(SWINDO)[3]",
01600 DY. = "DATUM(SWINDO)[4]",
01700 OX. = "DATUM(OWINDO)[1]",
01800 OY. = "DATUM(OWINDO)[2]",
01900 MP = "DATUM(OWINDO)[3]";
02000 INTEGER FLG;
00100 PRELOAD_WITH 1,2,3,4,0,0;
00200 SAFE INTEGER ARRAY CHAN[1:7];
00300 α NEW _DPYDD CALLS DDJOB;
00400 PROCEDURE _DPYDD; DPYDD(CVIS(TVFILE,FLG),∂(SWINDO),∂(OWINDO),CHAN);
01200 α SET CHANNELS;
01300 PROCEDURE SETCHN;
01400 BEGIN "SETCHN"
01500 INTEGER I,ARG;
01600 ARG ← INCHRW;
01700 IF ARG≤"0" ∨ "7"≤ARG THEN RETURN;
01800 ARG ← ARG LAND 7;
01900 CHAN[1] ← 0;
02000 ARRBLT(CHAN[2],CHAN[1],5);
02100 IF CHR="←" THEN CHAN[ARG]←1 ELSE
02200 IF CHR="↑" THEN FOR I←1 STEP 1 UNTIL ARG DO CHAN[I]←I ELSE
02300 IF CHR="↓" THEN FOR I←1 STEP 1 UNTIL ARG DO CHAN[I]←I+1 ELSE
02400 RETURN;
02500 _DPYDD;
02600 END "SETCHN";
00100 PROCEDURE CARCAM;
00200 BEGIN "CARCAM"
00300 DEFINE MM="*3.2808@-3";
00400 LDX ← 144;
00500 LDY ← 108;
00600 LDZ ← 500;
00700 PDX ← 5.3 MM;
00800 PDY ← 4.0 MM;
00900 FOCAL ← 12.5 MM;
01000 SCALX ← -FOCAL*LDX/PDX;
01100 SCALY ← -FOCAL*LDY/PDY;
01200 SCALZ ← FOCAL*LDZ;
01300 END "CARCAM";
01400
01700 PROCEDURE INITIALIZATION;
01800 BEGIN "INIT"
01900 INTEGER ARRAY ∂S[1:5],∂O[1:7];
02000 SWINDO ← NEW(∂S); NEW_PNAME(SWINDO,"S0");
02100 OWINDO ← NEW(∂O); NEW_PNAME(OWINDO,"O0");
02200 SX.←SY.←0;
02300 OX. ← 0;
02400 OY. ← 0;
02500 DX. ← 144;
02600 DY. ← 108;
02700 MP ← 0;
02800 DELTA ← 1;
02900 LINK ← NEW;
03000 NIL ← NEW;
03100 LOCOR ← NEW;
03200 CARCAM;
03300 OUTSTR("*");
03400 END "INIT";
00100 α WINDOW MOVING KEYS;
00200 PROCEDURE MOVKEY;
00300 BEGIN "MOVKEY"
00400 IF META THEN
00500 BEGIN
00600 IF CHR=";" ∧ OX.-DELTA≥0 THEN OX.←OX.-DELTA ELSE
00700 IF CHR=":" ∧ OX.+DELTA≤511 THEN OX.←OX.+DELTA ELSE
00800 IF CHR="(" ∧ OY.+DELTA*8<480 THEN OY.←OY.+DELTA*8 ELSE
00900 IF CHR=")" ∧ OY.-DELTA*8≥0 THEN OY.←OY.-DELTA*8 ;
01000 END ELSE
01100 IF CTRL THEN
01200 BEGIN
01300 IF CHR=";" THEN SX.←SX.-DELTA ELSE
01400 IF CHR=":" THEN SX.←SX.+DELTA ELSE
01500 IF CHR="(" THEN SY.←SY.-DELTA ELSE
01600 IF CHR=")" THEN SY.←SY.+DELTA;
01700 END ELSE
01800 BEGIN
01900 IF CHR=";" THEN SX.←SX.-DX. ELSE
02000 IF CHR=":" THEN SX.←SX.+DX. ELSE
02100 IF CHR="(" THEN SY.←SY.-DY. ELSE
02200 IF CHR=")" THEN SY.←SY.+DY.;
02300 END;
02400 IF SX.+DX.> 144 THEN SX.← 144-DX. ELSE
02500 IF SX.-DX.<-144 THEN SX.←-144+DX.;
02600 IF SY.+DY.> 108 THEN SY.← 108-DY. ELSE
02700 IF SY.-DY.<-108 THEN SY.←-108+DY.;
02800 _DPYDD;
02900 END "MOVKEY";
00100 α WINDOW SIZE CONTROL KEYS;
00200 PROCEDURE DELKEY;
00300 BEGIN "DELKEY"
00400 IF CHR="[" ∧ DY.≠1 THEN DY.←DY.-1 ELSE
00500 IF CHR="]" ∧ DY.≠108 THEN DY.←DY.+1 ELSE
00600 IF CHR="↑" ∧ DX.≠1 THEN DX.←DX.-1 ELSE
00700 IF CHR="↓" ∧ DX.≠144 THEN DX.←DX.+1;
00800 IF SX.+DX.> 144 THEN SX.← 144-DX. ELSE
00900 IF SX.-DX.<-144 THEN SX.←-144+DX.;
01000 IF SY.+DY.> 108 THEN SY.← 108-DY. ELSE
01100 IF SY.-DY.<-108 THEN SY.←-108+DY.;
01200 _DPYDD;
01300 END "DELKEY";
00100 PROCEDURE DIGIT;
00200 BEGIN "DIGIT"
00300 INTEGER DIG;
00400 DEFINE OXY(X,Y)="BEGIN OX.←X;OY.←Y;END";
00500 DIG ← CHR LAND '17;
00600 IF META THEN
00700 CASE DIG OF
00800 BEGIN
00900 OXY(0,0);
01000 OXY(128,120);
01100 OXY(-128,120);
01200 OXY(-128,-120);
01300 OXY(128,-120);
01400 OY.←120;
01500 OY.←-120;
01600 OX.←-128;
01700 OX.←0;
01800 OX.←128;
01900 END ELSE
02000 CASE DIG OF
02100 BEGIN
02200 SX.←SY.←0;
02300 MP←0;
02400 ;
02500 ;
02600 DX.←DY.←4;
02700 DX.←DY.←9;
02800 DX.←DY.←18;
02900 DX.←DY.←36;
03000 BEGIN DX.←72;DY.←54;END;
03100 BEGIN DX.←144;DY.←108;SX.←SY.←0;END;
03200 END;
03300 IF SX.+DX.> 144 THEN SX.← 144-DX. ELSE
03400 IF SX.-DX.<-144 THEN SX.←-144+DX.;
03500 IF SY.+DY.> 108 THEN SY.← 108-DY. ELSE
03600 IF SY.-DY.<-108 THEN SY.←-108+DY.;
03700 END "DIGIT";
00100 PROCEDURE INSERIES;
00200 BEGIN "INSERIES"
00300 INTEGER L,M,FLG;
00400 STRING STR,S;
00500 OPEN(1,"TTY",0,1,0,0,0,0);
00600 OUTSTR(" SERIES = ");S←INCHWL;
00700 OUTSTR(" FIRST = ");L←INTIN(1);
00800 OUTSTR(" LAST = ");M←INTIN(1);
00900 RELEASE(1);
01000 IF L>M THEN L↔M;
01100 DO BEGIN
01200 STR ← S&CVS(L);
01300 α DSKTV.;
01400 TVFILE←CVSI(STR,FLG);
01500 IF FLG THEN
01550 BEGIN
01575 TVFILE←NEW(0);
01587 PUT TVFILE IN TVSET;
01593 NEW_PNAME(TVFILE,STR);
01596 END;
01600 END UNTIL M<(L←L+1);
01700 OUTCHR("*");
01800 END "INSERIES";
01900
02000 α INPUT A 216 BY 288 TV IMAGE FROM THE DSK;
02100 PROCEDURE INDSK;
02200 BEGIN "INDSK"
02300 STRING STR;
02400 INTEGER FLG;
02500 OPEN(1,"DSK",8,3,0,0,0,0);
02600 OUTSTR(13&10);
02700 DO BEGIN
02800 OUTSTR ("FILE = ");
02900 STR ← INCHWL;
03000 IF STR<"A" ∨ "Z"<STR THEN BEGIN RELEASE(1);INSERIES;RETURN;END;
03100 LOOKUP(1,STR&".TMP[DAT,BGB]",FLG);
03200 END UNTIL ¬FLG;
03300 RELEASE(1);
03400 α DSKTV.(STR);
03500 TVFILE←CVSI(STR,FLG);
03600 IF FLG THEN
03700 BEGIN "NEWTV"
03800 TVFILE ← NEW(0);
03900 PUT TVFILE IN TVSET;
04000 NEW_PNAME(TVFILE,STR);
04100 END "NEWTV";
04200 OUTCHR("*");
04300 END "INDSK";
00100 α ALLIGN THE CAMERA ORIENTATION TO POINT AT A LANDMARK FEATURE;
00200 PROCEDURE ALLIGN;
00300 BEGIN "ALLIGN"
00400 REAL ARRAY C[1:4,1:3],U,V[1:3];
00500 REAL ARRAY ITEMVAR F,CAM;
00600 REAL ARRAY ITEMVAR FWN;
00700 SET Q;
00800 STRING STR;
00900 INTEGER FLG,I;
01000 REAL AZM1,AZM2,ALT1,ALT2,PAN,TILT,CP,SP,CT,ST;
01100 DEFINE THRICE="FOR I←1 STEP 1 UNTIL 3 DO";
01200 DEFINE GETOUT(STR)="BEGIN OUTSTR(↓&9&STR&↓&""*"");RETURN;END";
01300
01400 α COMPUTE AZMUTH AND ALTITUDE ANGLES;
01500 PROCEDURE AZMALT (REAL ARRAY V;REFERENCE REAL AZ,AL);
01600 BEGIN
01700 REAL RXY;
01800 RXY ← SQRT(V[1]↑2 + V[2]↑2);
01900 AZ ← ATAN2(V[2],V[1]);
02000 AL ← ATAN2(V[3],RXY);
02100 END;
00100 α GET A FEATURE FROM THE USER;
00200 OUTSTR(9&"FEATURE = ");
00300 STR ← INCHWL;
00400 F ← CVSI(STR,FLG);
00500 IF FLG THEN GETOUT("""FEATURE NOT FOUND""");
00600 Q ← TVFILE⊗F;
00700 IF LENGTH(Q)=0 THEN GETOUT("""FEATURE NOT IN IMAGE""");
00800 FWN ← LOP(Q);
00900 Q ← LOCOR⊗TVFILE;
01000 IF LENGTH(Q)=0 THEN
01100 BEGIN
01200 OUTSTR("NEW CAMERA MADE"&↓);
01300 CAM ← NEW(C);
01400 MAKE LOCOR⊗TVFILE≡CAM;
01500 END ELSE
01600 CAM ← LOP(Q);
00100 α GET AZM & ALT OF VECTOR FROM CAMERA TO LANDMARK;
00200 THRICE V[I]←∂(F)[I]-∂(CAM)[4,I];
00300 AZMALT(V,AZM1,ALT1);
00400 α GET AZM & ALT OF VECTOR FROM CAMERA THRU THE RASTER;
00500 U[2] ← PDX*∂(FWN)[1]/LDX;
00600 U[3] ← PDY*∂(FWN)[2]/LDY;
00700 U[1] ← -FOCAL;
00800 AZMALT(U,AZM2,ALT2);
00900 α GET THE CCW DIFFERENCE;
01000 PAN ← AZM1-AZM2;
01100 TILT ← ALT1-ALT2;
01200 CP ← COS(PAN);
01300 CT ← COS(TILT);
01400 SP ← SIN(PAN);
01500 ST ← SIN(TILT);
01600 α RESET THE CAMERA ORIENTATION;
01700 C[1,1] ← -SP;
01800 C[1,2] ← CP;
01900 C[1,3] ← 0;
02000 C[2,1] ← ST*CP;
02100 C[2,2] ← ST*SP;
02200 C[2,3] ← CT;
02300 C[3,1] ← CT*CP;
02400 C[3,2] ← CT*SP;
02500 C[3,3] ← -ST;
00100 α CHECK THE ANSWER;
00200 BEGIN "CHECK"
00300 REAL MX,MY,DX,DY,R;
00700 THRICE U[I]←∂(F)[I]-∂(CAM)[4,I];
00800 THRICE V[I]←C[I,1]*U[1]+C[I,2]*U[2]+C[I,3]*U[3];
00900 IF V[3] > -FOCAL THEN OUTSTR("BEHIND CAMERA"&↓) ELSE
01000 BEGIN
01100 MX ← SCALX*V[1]/V[3];
01200 MY ← SCALY*V[2]/V[3];
01300 OUTSTR(" APPEARS AT "&CVG(∂(FWN)[1])&9&CVG(∂(FWN)[2])&↓);
01400 OUTSTR(" SHOULD BE AT "&CVG(MX)&9&CVG(MY)&↓);
01500 END;
01600
01700 α SUPRESS REDSIDUAL ERROR IN THE ALLIGNMENT;
01800 DX ← (∂(FWN)[1]-MX)*PDX/LDX;
01900 DY ← (∂(FWN)[2]-MY)*PDY/LDY;
02000 R ← SQRT(FOCAL↑2 + DX↑2);
02100 CP ← FOCAL/R;
02200 SP ← DX/R;
02300 R ← SQRT(FOCAL↑2 + DY↑2);
02400 CT ← FOCAL/R;
02500 ST ← -DY/R;
02600 THRICE
02700 BEGIN
02800 R ← C[I,1]*CP - C[I,2]*SP;
02900 C[I,2] ← C[I,1]*SP + C[I,2]*CP;
03000 C[I,1] ← R;
03100 END;
03200 THRICE
03300 BEGIN
03400 R ← C[I,1]*CT - C[I,3]*ST;
03500 C[I,3] ← C[I,1]*ST + C[I,3]*CT;
03600 C[I,1] ← R;
03700 END;
03800 THRICE V[I]←C[I,1]*U[1]+C[I,2]*U[2]+C[I,3]*U[3];
03900 MX ← SCALX*V[1]/V[3];
04000 MY ← SCALY*V[2]/V[3];
04100 OUTSTR(" APPEARS AT "&CVG(∂(FWN)[1])&9&CVG(∂(FWN)[2])&↓);
04200 OUTSTR(" SHOULD BE AT "&CVG(MX)&9&CVG(MY)&↓);
04300
04400 END "CHECK";
00100 α UPDATE CAMERA LOCUS - TYPE A BEFORE & AFTER MESSAGE;
00200 THRICE V[I]←∂(CAM)[3,I];
00300 AZMALT(V,AZM2,ALT2);
00400 OUTSTR(" CAMERA BEFORE ");
00500 OUTSTR(CVS(180*AZM2/π)&9);
00600 OUTSTR(CVS(180*ALT2/π)&↓);
00700 ARRBLT(∂(CAM)[1,1],C[1,1],9);
00800 THRICE V[I]←C[3,I];
00900 AZMALT(V,AZM2,ALT2);
01000 OUTSTR(" CAMERA AFTER ");
01100 OUTSTR(CVS(180*AZM2/π)&9);
01200 OUTSTR(CVS(180*ALT2/π)&↓);
01300 OUTCHR("*");
01400 END "ALLIGN";
00100 α EXTERNAL; PROCEDURE INFEA;;
00200 α EXTERNAL; PROCEDURE OUTFEA;;
00300 α EXTERNAL; PROCEDURE INFWN;;
00400 α EXTERNAL; PROCEDURE OUTFWN;;
00500 α EXTERNAL; PROCEDURE INCAM;;
00600 α EXTERNAL; PROCEDURE OUTCAM;;
00700 α EXTERNAL; PROCEDURE PARALLAX;;
00800 α EXTERNAL; PROCEDURE MARKER;;
00900 α EXTERNAL; PROCEDURE SHOWFE(BOOLEAN X);;
01000 α EXTERNAL; PROCEDURE LOCUS;;
01100 α EXTERNAL; PROCEDURE SCROLL;;
00100 PROCEDURE XXXXXX;
00200 BEGIN "XXXXXX"
00300 WHILE TRUE DO
00400 BEGIN "LISTEN"
00500 CHR ← INCHRW;
00600 MCBITS ← (CHR LSH -7)LAND 3;
00700 CTRL ← CHR LAND '200;
00800 META ← CHR LAND '400;
00900 CHR ← CHR LAND '177;
01000 LETT ← CHR LAND '37;
01100 IF "A"≤CHR ∧ CHR≤"Z" ∨ "a"≤CHR ∧ CHR≤"z" THEN
01200 CASE LETT OF
01300 BEGIN ;
01400 "A" ALLIGN;
01500 "B" ;
01600 "C" ;
01700 "D" _DPYDD;
01800 "E" ERASTV;
01900 "F" CASE MCBITS OF BEGIN ;;PARALLAX;;END;
02000 "G" ;
02100 "H" ;
02200 "I" CASE MCBITS OF BEGIN INDSK;INFEA;INFWN;INCAM;END;
02300 "J" ;
02400 "K" ;
02500 "L" LOCUS;
02600 "M" IF CTRL THEN SCROLL ELSE MARKER;
02700 "N" ;
02800 "O" CASE MCBITS OF BEGIN;OUTFEA;OUTFWN;OUTCAM;END;
02900 "P" ;
03000 "Q" ;
03100 "R" ;
03200 "S" SHOWFE(CTRL);
03300 "T" ;
03400 "U" ;
03500 "V" ;
03600 "W" ;
03700 "X" ;
03800 "Y" ;
03900 "Z" ;
04000 END ELSE
00100 α ASCII 00 TO 37 ;
00200 IF CHR < "A" THEN CASE CHR OF BEGIN
00300 "NULL" ;
00400 "↓" SETCHN;
00500 "α" ;
00600 "β" ;
00700 "∧" ;
00800 "¬" ;
00900 "ε" ;
01000 "π" ;
01100 "λ" ;
01200 "TAB" ;
01300 "LF" ;
01400 "VT" ;
01500 "FF" ;
01600 "CR" OUTSTR("*");
01700 "∞" ;
01800 "∂" ;
01900 "⊂" ;
02000 "⊃" ;
02100 "∩" ;
02200 "∪" ;
02300 "∀" ;
02400 "∃" ;
02500 "⊗" ;
02600 "↔" ;
02700 "_" ;
02800 "→" ;
02900 "TILDE" ;
03000 "≠" ;
03100 "≤" ;
03200 "≥" ;
03300 "≡" ;
03400 "∨" ;
00100 α ASCII 40 TO 77;
00200 "SPACE" ;
00300 "!" ;
00400 """" ;
00500 "#" BEGIN INTEGER I;FOR I←1 STEP 1 UNTIL 30 DO OUTSTR(13&10);END;
00600 "$" ;
00700 "%" ;
00800 "&" ;
00900 "'" ;
01000 "(" MOVKEY;
01100 ")" MOVKEY;
01200 "*" MP←MP+1;
01300 "+" ;
01400 "," ;
01500 "-" IF MP≠0 THEN MP←MP-1;
01600 "." ;
01700 "/" IF DELTA≠1 THEN DELTA←DELTA-1;
01800 "0" DIGIT;
01900 "1" DIGIT;
02000 "2" DIGIT;
02100 "3" DIGIT;
02200 "4" DIGIT;
02300 "5" DIGIT;
02400 "6" DIGIT;
02500 "7" DIGIT;
02600 "8" DIGIT;
02700 "9" DIGIT;
02800 ":" MOVKEY;
02900 ";" MOVKEY;
03000 "<" ;
03100 "=" ;
03200 ">" ;
03300 "?" ;
03400 "@" ;
03500 END ELSE
00100 IF CHR<"a" THEN CASE CHR-'133 OF
00200 BEGIN
00300 "[" DELKEY;
00400 "\" DELTA←DELTA+1;
00500 "]" DELKEY;
00600 "↑" SETCHN;
00700 "←" SETCHN;
00800 "`" ;
00900 END
01000 ELSE CASE CHR-'173 OF
01100 BEGIN
01200 "{" ;
01300 "|" ;
01400 "ALTMODE" ;
01500 "}" ;
01600 "RUBOUT";
01700 END;
01800 END "LISTEN";
01900 END "XXXXXX";
02000
02100 INITIALIZATION;
02200 XXXXXX;
02300 END "HIA"